home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-20
/
morse1.zip
/
MORSE.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1990-10-14
|
14KB
|
492 lines
Program Morse;
Var
Choice : Char;
N, M : Integer;
CodeLine : String[72];
Letter : Char;
Key : Integer;
I : Integer;
F : Integer;
Lines : Integer;
WordsMin : Integer;
LetterFlag : Integer;
Procedure ShowCode;
Var
DT,DA : String[4];
Begin
DT := #223+#32;
DA := #223+#223+#223+#32;
GotoXY(1,12);
ClrEOL;
GotoXY(N,12);
If N > 60 then GotoXY(60,12);
Case Letter of
'A': Write(DT,DA);
'B': Write(DA,DT,DT,DT);
'C': Write(DA,DT,DA,DT);
'D': Write(DA,DT,DT);
'E': Write(DT);
'F': Write(DT,DT,DA,DT);
'G': Write(DA,DA,DT);
'H': Write(DT,DT,DT,DT);
'I': Write(DT,DT);
'J': Write(DT,DA,DA,DA);
'K': Write(DA,DT,DA);
'L': Write(DT,DA,DT,DT);
'M': Write(DA,DA);
'N': Write(DA,DT);
'O': Write(DA,DA,DA);
'P': Write(DT,DA,DA,DT);
'Q': Write(DA,DA,DT,DA);
'R': Write(DT,DA,DT);
'S': Write(DT,DT,DT);
'T': Write(DA);
'U': Write(DT,DT,DA);
'V': Write(DT,DT,DT,DA);
'W': Write(DT,DA,DA);
'X': Write(DA,DT,DT,DA);
'Y': Write(DA,DT,DA,DA);
'Z': Write(DA,DA,DT,DT);
'0': Write(DA,DA,DA,DA,DA);
'1': Write(DT,DA,DA,DA,DA);
'2': Write(DT,DT,DA,DA,DA);
'3': Write(DT,DT,DT,DA,DA);
'4': Write(DT,DT,DT,DT,DA);
'5': Write(DT,DT,DT,DT,DT);
'6': Write(DA,DT,DT,DT,DT);
'7': Write(DA,DA,DT,DT,DT);
'8': Write(DA,DA,DA,DT,DT);
'9': Write(DA,DA,DA,DA,DT);
'.': Write(DT,DA,DT,DA,DT,DA)
End;
End;
Procedure Dit;
Begin
Sound(F);
Delay(I);
NoSound;
Delay(I);
End;
Procedure Dah;
Begin
Sound(F);
Delay(3*I);
NoSound;
Delay(I);
End;
Procedure LSpace;
Begin
NoSound;
Delay(2*I);
End;
Procedure WSpace;
Begin
NoSound;
Delay(4*I);
End;
Procedure SoundLtr;
Var
Input : Integer;
Z : Integer;
Procedure MakeLtr;
Begin
Key := Random(10000) mod 26;
Case Key of
1 : Letter := 'A';
2 : Letter := 'B';
3 : Letter := 'C';
4 : Letter := 'D';
5 : Letter := 'E';
6 : Letter := 'F';
7 : Letter := 'G';
8 : Letter := 'H';
9 : Letter := 'I';
10 : Letter := 'J';
11 : Letter := 'K';
12 : Letter := 'L';
13 : Letter := 'M';
14 : Letter := 'N';
15 : Letter := 'O';
16 : Letter := 'P';
17 : Letter := 'Q';
18 : Letter := 'R';
19 : Letter := 'S';
20 : Letter := 'T';
21 : Letter := 'U';
22 : Letter := 'V';
23 : Letter := 'W';
24 : Letter := 'X';
25 : Letter := 'Y';
26 : Letter := 'Z';
27 : Letter := '0';
28 : Letter := '1';
29 : Letter := '2';
30 : Letter := '3';
31 : Letter := '4';
32 : Letter := '5';
33 : Letter := '6';
34 : Letter := '7';
35 : Letter := '8';
36 : Letter := '9';
37 : Letter := '.';
End;
End;
Procedure ShowLtr;
Var
DT,DA : String[4];
Begin
DT := #223+#32;
DA := #223+#223+#223+#32;
GotoXY(25,10);
ClrEOL;
Write(Letter,' ');
Case Letter of
'A': Write(DT,DA);
'B': Write(DA,DT,DT,DT);
'C': Write(DA,DT,DA,DT);
'D': Write(DA,DT,DT);
'E': Write(DT);
'F': Write(DT,DT,DA,DT);
'G': Write(DA,DA,DT);
'H': Write(DT,DT,DT,DT);
'I': Write(DT,DT);
'J': Write(DT,DA,DA,DA);
'K': Write(DA,DT,DA);
'L': Write(DT,DA,DT,DT);
'M': Write(DA,DA);
'N': Write(DA,DT);
'O': Write(DA,DA,DA);
'P': Write(DT,DA,DA,DT);
'Q': Write(DA,DA,DT,DA);
'R': Write(DT,DA,DT);
'S': Write(DT,DT,DT);
'T': Write(DA);
'U': Write(DT,DT,DA);
'V': Write(DT,DT,DT,DA);
'W': Write(DT,DA,DA);
'X': Write(DA,DT,DT,DA);
'Y': Write(DA,DT,DA,DA);
'Z': Write(DA,DA,DT,DT);
'0': Write(DA,DA,DA,DA,DA);
'1': Write(DT,DA,DA,DA,DA);
'2': Write(DT,DT,DA,DA,DA);
'3': Write(DT,DT,DT,DA,DA);
'4': Write(DT,DT,DT,DT,DA);
'5': Write(DT,DT,DT,DT,DT);
'6': Write(DA,DT,DT,DT,DT);
'7': Write(DA,DA,DT,DT,DT);
'8': Write(DA,DA,DA,DT,DT);
'9': Write(DA,DA,DA,DA,DT);
'.': Write(DT,DA,DT,DA,DT,DA)
End;
End;
Procedure BeepLtr;
Begin
Case Letter of
'A': Begin Dit;Dah;LSpace;End;
'B': Begin Dah;Dit;Dit;Dit;LSpace;End;
'C': Begin Dah;Dit;Dah;Dit;LSpace;End;
'D': Begin Dah;Dit;Dit;LSpace;End;
'E': Begin Dit;LSpace;End;
'F': Begin Dit;Dit;Dah;Dit;LSpace;End;
'G': Begin Dah;Dah;Dit;LSpace;End;
'H': Begin Dit;Dit;Dit;Dit;LSpace;End;
'I': Begin Dit;Dit;LSpace;End;
'J': Begin Dit;Dah;Dah;Dah;LSpace;End;
'K': Begin Dah;Dit;Dah;LSpace;End;
'L': Begin Dit;Dah;Dit;Dit;LSpace;End;
'M': Begin Dah;Dah;LSpace;End;
'N': Begin Dah;Dit;LSpace;End;
'O': Begin Dah;Dah;Dah;LSpace;End;
'P': Begin Dit;Dah;Dah;Dit;LSpace;End;
'Q': Begin Dah;Dah;Dit;Dah;LSpace;End;
'R': Begin Dit;Dah;Dit;LSpace;End;
'S': Begin Dit;Dit;Dit;LSpace;End;
'T': Begin Dah;LSpace;End;
'U': Begin Dit;Dit;Dah;LSpace;End;
'V': Begin Dit;Dit;Dit;Dah;LSpace;End;
'W': Begin Dit;Dah;Dah;LSpace;End;
'X': Begin Dah;Dit;Dit;Dah;LSpace;End;
'Y': Begin Dah;Dit;Dah;Dah;LSpace;End;
'Z': Begin Dah;Dah;Dit;Dit;LSpace;End;
'0': Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
'1': Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
'2': Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
'3': Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
'4': Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
'5': Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
'6': Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
'7': Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
'8': Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
'9': Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
'.': Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
#32: WSpace;
End;
For N := 1 to Input do
Begin
WSpace;
End;
End;
Begin
ClrScr;
GotoXY(10,10);
Write('How many spaces between letters (1 to 8)');
GotoXY(10,11);
Repeat
Read(Kbd,Choice);
Until Choice in ['1'..'8'];
Val(Choice,Input,Z);
ClrScr;
Randomize;
While Not Keypressed do
Begin
MakeLtr;
ShowLtr;
BeepLtr;
End;
End;
{***********}
Procedure ReadCode;
Begin
GotoXY(1,10);
Write(Codeline);
For N := 1 to Length(CodeLine) do
Begin
GotoXY(1,6);
Write('Transmitting at ',WordsMin,' words per minute');
GotoXY(1,8);
Write('This will generate ',Lines,' Lines. This is Line ',M);
Delay(I);
Letter := Copy(Codeline,N,1);
ShowCode;
GotoXY(N,10);
Case Letter of
'A': Begin Dit;Dah;LSpace;End;
'B': Begin Dah;Dit;Dit;Dit;LSpace;End;
'C': Begin Dah;Dit;Dah;Dit;LSpace;End;
'D': Begin Dah;Dit;Dit;LSpace;End;
'E': Begin Dit;LSpace;End;
'F': Begin Dit;Dit;Dah;Dit;LSpace;End;
'G': Begin Dah;Dah;Dit;LSpace;End;
'H': Begin Dit;Dit;Dit;Dit;LSpace;End;
'I': Begin Dit;Dit;LSpace;End;
'J': Begin Dit;Dah;Dah;Dah;LSpace;End;
'K': Begin Dah;Dit;Dah;LSpace;End;
'L': Begin Dit;Dah;Dit;Dit;LSpace;End;
'M': Begin Dah;Dah;LSpace;End;
'N': Begin Dah;Dit;LSpace;End;
'O': Begin Dah;Dah;Dah;LSpace;End;
'P': Begin Dit;Dah;Dah;Dit;LSpace;End;
'Q': Begin Dah;Dah;Dit;Dah;LSpace;End;
'R': Begin Dit;Dah;Dit;LSpace;End;
'S': Begin Dit;Dit;Dit;LSpace;End;
'T': Begin Dah;LSpace;End;
'U': Begin Dit;Dit;Dah;LSpace;End;
'V': Begin Dit;Dit;Dit;Dah;LSpace;End;
'W': Begin Dit;Dah;Dah;LSpace;End;
'X': Begin Dah;Dit;Dit;Dah;LSpace;End;
'Y': Begin Dah;Dit;Dah;Dah;LSpace;End;
'Z': Begin Dah;Dah;Dit;Dit;LSpace;End;
'0': Begin Dah;Dah;Dah;Dah;Dah;LSpace;End;
'1': Begin Dit;Dah;Dah;Dah;Dah;LSpace;End;
'2': Begin Dit;Dit;Dah;Dah;Dah;LSpace;End;
'3': Begin Dit;Dit;Dit;Dah;Dah;LSpace;End;
'4': Begin Dit;Dit;Dit;Dit;Dah;LSpace;End;
'5': Begin Dit;Dit;Dit;Dit;Dit;LSpace;End;
'6': Begin Dah;Dit;Dit;Dit;Dit;LSpace;End;
'7': Begin Dah;Dah;Dit;Dit;Dit;LSpace;End;
'8': Begin Dah;Dah;Dah;Dit;Dit;LSpace;End;
'9': Begin Dah;Dah;Dah;Dah;Dit;LSpace;End;
'.': Begin Dit;Dah;Dit;Dah;Dit;Dah;LSpace;End;
#32: WSpace;
End;
If Keypressed then Halt;
End;
End;
Procedure LoadCode;
Type
TxtType = Text;
Var
Filename : String[12];
TxtFile : TxtType;
Item : Char;
Begin
ClrScr;
Window(15,5,65,20);
Writeln;
Writeln('CHOOSE A FILE FROM THIS LIST');
Writeln;
Writeln(' 1. Code1');
Writeln(' 2. Code2');
Writeln(' 3. Code3');
Writeln(' 4. Code4');
Repeat
Read(Kbd,Item);
Until Item in ['1','2','3','4'];
Window(1,1,80,25);
ClrScr;
Writeln;
Case Item of
'1': Filename := 'Code1.TXT';
'2': Filename := 'Code2.TXT';
'3': Filename := 'Code3.TXT';
'4': Filename := 'Code4.TXT';
End;
Assign(TxtFile, Filename);
Reset(TxtFile);
While Not EOF(TxtFile) do
Begin
Readln(TxtFile,CodeLine);
ReadCode;
End;
End;
Procedure Generator;
Begin
ClrScr;
Writeln('How many lines');
ReadLn(Lines);
For M := 1 to lines do
Begin
CodeLine := '';
Randomize;
For N := 1 to 66 do
Begin
Key := Random(10000) mod LetterFlag;
Case Key of
1 : Letter := 'A';
2 : Letter := 'B';
3 : Letter := 'C';
4 : Letter := 'D';
5 : Letter := 'E';
6 : Letter := 'F';
7 : Letter := 'G';
8 : Letter := 'H';
9 : Letter := 'I';
10 : Letter := 'J';
11 : Letter := 'K';
12 : Letter := 'L';
13 : Letter := 'M';
14 : Letter := 'N';
15 : Letter := 'O';
16 : Letter := 'P';
17 : Letter := 'Q';
18 : Letter := 'R';
19 : Letter := 'S';
20 : Letter := 'T';
21 : Letter := 'U';
22 : Letter := 'V';
23 : Letter := 'W';
24 : Letter := 'X';
25 : Letter := 'Y';
26 : Letter := 'Z';
27 : Letter := '0';
28 : Letter := '1';
29 : Letter := '2';
30 : Letter := '3';
31 : Letter := '4';
32 : Letter := '5';
33 : Letter := '6';
34 : Letter := '7';
35 : Letter := '8';
36 : Letter := '9';
37 : Letter := '.';
End;
If Length(Codeline) mod 6 = 0 then Letter := #32;
CodeLine := Codeline + Letter;
End;
ClrScr;
ReadCode;
End;
End;
Procedure Menu;
Begin
Window(15,5,65,25);
ClrScr;
Writeln(' MORSE CODE PRACTICE');
Writeln;
Writeln('This program will:');
Writeln;
Writeln('1. Generate random text groups of 5 characters');
Writeln(' each, then send them in morse code with the');
Writeln(' cursor underlining each word as it is sent.');
Writeln;
Writeln('2. Read text files prepared by your word processor');
Writeln(' in capitals, then send the text line by line');
Writeln;
Writeln('3. Sound individual random letters well spaced');
Writeln;
Writeln('"Frequency" sets the oscillator frequency');
Writeln;
Writeln(' *** Press any key to continue ** ');
Repeat until keypressed;
ClrScr;
Writeln('MORSE CODE PRACTICE');
Writeln;
Writeln('What Speed? (Enter Words Per Minute)');
Readln(WordsMin);
I := Round(800/WordsMin);
Writeln('What Frequency');
Readln(F);
Writeln('Do you want to :');
Writeln;
Writeln('1. Generate Random Code?');
Writeln('2. Read Code From a File?');
Writeln('3. Sound individual letters?');
Writeln('4. End Program');
Repeat
Read(Kbd, Choice);
Until Choice in ['1','2','3','4'];
Window(1,1,80,25);
End;
BEGIN
Repeat
ClrScr;
Menu;
If Choice = '1'then
Begin
ClrScr;
GotoXY(15,5);
Write('Include numerals in code groups? (Y/N)');
GotoXY(15,6);
Read(Kbd,Choice);
If Choice in ['y','Y'] then LetterFlag := 37
Else LetterFlag := 26;
Generator;
End;
If Choice = '2' then LoadCode;
If Choice = '3' then SoundLtr;
Until Choice = '4';
END.